home *** CD-ROM | disk | FTP | other *** search
/ Gamers Delight 2 / Gamers Delight 2.iso / Aminet / game / gag / HAMmmm2.lha / JGoodies / HAMmmm2 / mmm_sound < prev    next >
Text File  |  1989-08-21  |  2KB  |  120 lines
  1. \ Play a just intoned chord that responds to the
  2. \ graphic activity.  The waveform will be set
  3. \ to the Y values of the points.  The pitch will be
  4. \ set to the average x position.
  5. \
  6. \ The DA.xxx words can be found in HMSL which
  7. \ is a music language written Phil Burk, Larry Polansky,
  8. \ and David Rosenboom at the Mills College Center for
  9. \ Contemporary music.  A set of stubs are provided
  10. \ for JForth users who do not have HMSL.
  11. \
  12. \ Author: Phil Burk
  13. \ Copyright 1987 Phil Burk
  14. \ This code is considered to be in the public domain and
  15. \ may be freely distributed but may not be sold for profit.
  16.  
  17. ANEW TASK-MMM_SOUND
  18.  
  19. variable WAVEFORM-1
  20. 16 constant WAVELENGTH
  21.  
  22. : ALLOC.WAVE  ( -- , allocate CHIP RAM for waveform )
  23.     MEMF_CHIP wavelength allocblock ?dup
  24.     IF waveform-1 !
  25.     ELSE ." Couldn't allocate waveform." cr
  26.          abort
  27.     THEN
  28. ;
  29.  
  30. : FREE.WAVE ( -- )
  31.     waveform-1 @ ?dup
  32.     IF freeblock  waveform-1 off
  33.     THEN
  34. ;
  35.  
  36. : CHANGE.TIMBRE  ( -- , copy y positions )
  37.     ham_num_points wavelength min 0
  38.     DO  120 i ham-y-pos @ -
  39.         waveform-1 @ i + c!
  40.     LOOP
  41. ;
  42.  
  43. \ Use ratiometric tuning to get chord.
  44. CREATE CHORD-DENOMS 1 , 2 , 4 , 7 ,
  45. CREATE CHORD-NUMERS 1 , 3 , 5 , 12 ,
  46.  
  47. : NEW.RATIO  ( -- numer denom , ratio between 1 and 2 )
  48.     9 choose 1+
  49.     dup choose
  50.     over + 1+ swap
  51. ;
  52.  
  53. : CHANGE.CHORD  ( -- , randomly change chord )
  54.     4 1
  55.     DO  new.ratio
  56.         i cells chord-denoms + !
  57.         i cells chord-numers + !
  58.     LOOP
  59. ;
  60.  
  61. : SET.WAVEFORMS ( -- , use same waveform on all four channels )
  62.     4 0
  63.     DO  i da.channel!
  64.         waveform-1 @ wavelength da.sample!
  65.     LOOP
  66. ;
  67.  
  68. : START.SOUND ( -- , start all four channels sounding )
  69.     4 0
  70.     DO  i da.channel!
  71.         da.start
  72.     LOOP
  73. ;
  74.  
  75. : SET.PITCH ( period -- , play chord )
  76.     4 0
  77.     DO  i da.channel!
  78.         dup i cells chord-numers + @
  79.         i cells chord-denoms + @ */
  80.         da.period!
  81.         da.start
  82.     LOOP drop
  83. ;
  84.  
  85. : AVERAGE.X.POS ( -- x , calculate it )
  86.     0 ham_num_points 0
  87.     DO i ham-x-pos @ +
  88.     LOOP
  89.     ham_num_points /
  90. ;
  91.  
  92. : CHANGE.PITCH ( -- , set pitch to average x )
  93.     average.x.pos
  94.     4 * 500 +
  95.     set.pitch
  96. ;
  97.  
  98. : CHANGE.SOUND ( -- , make all changes )
  99.     change.timbre
  100.     change.pitch
  101. ;
  102.  
  103. : STOP.SOUND ( -- )
  104.     da.kill
  105. ;
  106.  
  107. : SOUND.INIT ( -- )
  108.     da.init
  109.     alloc.wave
  110.     set.waveforms
  111.     change.sound
  112.     start.sound
  113. ;
  114.  
  115. : SOUND.TERM ( -- )
  116.     stop.sound
  117.     free.wave
  118.     da.term
  119. ;
  120.